perm filename QSUBST.LSP[QLA,LSP] blob
sn#841074 filedate 1987-06-03 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (defmacro lock-cons (x y)
C00004 ENDMK
Cā;
(defmacro lock-cons (x y)
`(prog2 (get-lock *cons-lock*)
(cons ,x ,y)
(release-lock *cons-lock*)))
(defun init (m n atoms)
(let ((atoms (subst () () atoms)))
(do ((a atoms (cdr a)))
((null (cdr a)) (setf (cdr a) atoms)))
(init1 m n atoms)))
(defun init1 (m n atoms)
(cond ((= m 0) (pop atoms))
(t (do ((i n (- i 2))
(a ()))
((< i 1) a)
(push (pop atoms) a)
(push (init1 (1- m) n atoms) a)))))
(defun bin-init (depth one other)
(cond ((zerop depth) one)
(t (cons (bin-init (1- depth) other one)
(bin-init (1- depth) other one)))))
(defun sbst (x y z)
(cond ((eq y z) x)
((atom z) z)
(t
(qlet nil ((q (sbst x y (car z)))
(r (sbst x y (cdr z))))
(lock-cons q r)))))
(defun qsubst (x y z)
(cond ((eq y z) x)
((atom z) z)
(t
(qlet t ((q (qsubst x y (car z)))
(r (qsubst x y (cdr z))))
(lock-cons q r)))))
(defun qsubst2 (x y z)
(cond ((eq y z) x)
((atom z) z)
(t
(qlet t ((q (sbst x y (car z)))
(r (sbst x y (cdr z))))
(lock-cons q r)))))